home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / NEWINT~1 / OWNERD~1 / PROGBA~1.CLS < prev    next >
Text File  |  1997-06-05  |  7KB  |  215 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CProgBar32"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10.  
  11. Option Explicit
  12.  
  13. Private ProgressStyle As Long
  14. Dim ProgBarWnd As Long
  15. Private TempParent As Object
  16. Private Const WM_COMMAND = &H111
  17. Private Const WM_COMMNOTIFY = &H44
  18. Private NoObjectParent As Long
  19. Private Type tagInitCommonControlsEx
  20.     lngSize As Long
  21.     lngICC As Long
  22. End Type
  23. Const ICC_PROGRESS_CLASS = &H20
  24. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  25. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  26. Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
  27. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  28. Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As String) As Long
  29. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  30. Private Declare Function SendStringMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
  31. Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  32. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  33. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  34. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  35. Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  36. Private Const MF_OWNERDRAW& = &H100&
  37.  
  38. Const HWND_TOPMOST = -1
  39. Const SW_HIDE = 0
  40. Const SW_SHOWNORMAL = 1
  41. Const SWP_NOSIZE = &H1
  42. Const SWP_NOMOVE = &H2
  43. Const SWP_NOREDRAW = &H8
  44. Const SWP_SHOWWINDOW = &H40
  45.  
  46. Private Type tagTBADDBITMAP
  47.         hinst As Long
  48.         nID As Long
  49. End Type
  50.  
  51. Private Const COLOR_BTNFACE = 15
  52. Private Const COLOR_BTNTEXT = 18
  53.  
  54. ' Window Style constants
  55. Const WS_VISIBLE = &H10000000
  56. Const WS_CHILD = &H40000000
  57. Const WS_POPUP = &H80000000
  58.  
  59. ' CreateWindow constants
  60. Const CW_USEDEFAULT = &H80000000
  61.  
  62. Private Const WM_PAINT = &HF
  63.  
  64. Private Const WM_USER = &H400
  65. Private Const GWL_HWNDPARENT = (-8)
  66. Private Const GWL_STYLE = (-16)
  67. Private Const WS_BORDER = &H800000
  68. Private Const WM_DRAWITEM = &H2B
  69. Private Const WS_CLIPCHILDREN = &H2000000
  70. Private Const WS_CLIPSIBLINGS = &H4000000
  71. Private Const WM_SETREDRAW = &HB
  72. '//Common Control Constants
  73. Private Const CCS_TOP = &H1
  74. Private Const CCS_NOMOVEY = &H2
  75. Private Const CCS_BOTTOM = &H3
  76. Private Const CCS_NORESIZE = &H4
  77. Private Const CCS_NOPARENTALIGN = &H8
  78. 'Private Const CCS_ADJUSTABLE          0x00000020L
  79. Private Const CCS_NODIVIDER = &H40
  80.  
  81.  
  82. Private Const PROGRESS_CLASSA = "msctls_progress32"
  83.  
  84. 'Style
  85. Private Const PBS_SMOOTH = &H1
  86. Private Const PBS_VERTICAL = &H4
  87. Private Const PBM_SETRANGE = (WM_USER + 1)
  88. Private Const PBM_SETPOS = (WM_USER + 2)
  89. Private Const PBM_DELTAPOS = (WM_USER + 3)
  90. Private Const PBM_SETSTEP = (WM_USER + 4)
  91. Private Const PBM_STEPIT = (WM_USER + 5)
  92. Private Const PBM_SETRANGE32 = (WM_USER + 6)
  93. Private Const PBM_GETRANGE = (WM_USER + 7)
  94. Private Const PBM_GETPOS = (WM_USER + 8)
  95.  
  96. Private Type PPBRange
  97.         iLow As Integer
  98.         iHigh As Integer
  99. End Type
  100. Public Sub SetProgVert(Vertical As Boolean)
  101. If Vertical = True Then
  102. ProgressStyle = PBS_VERTICAL
  103. Else
  104. ProgressStyle = 0
  105. End If
  106. End Sub
  107.  
  108.  
  109. Private Sub Class_Initialize()
  110.  Dim iccex As tagInitCommonControlsEx
  111.     With iccex
  112.         .lngSize = LenB(iccex)
  113.         .lngICC = ICC_PROGRESS_CLASS
  114.     End With
  115.     Call InitCommonControlsEx(iccex)
  116.   
  117.     ProgBarWnd = 0
  118. End Sub
  119. Public Function Create( _
  120.  Optional Left As Variant, _
  121.  Optional Top As Variant, _
  122.  Optional Width As Variant, _
  123.  Optional Height As Variant, Optional Smooth As Boolean) _
  124.   As Boolean
  125.   
  126.    
  127. Dim SmoothVal As Long
  128. 'Convert to Smooth if required
  129. If Smooth = True Then SmoothVal = PBS_SMOOTH
  130.     
  131. 'If we are placing on a window handle (hwnd) then
  132. If NoObjectParent <> 0 Then
  133. ProgBarWnd = CreateWindowEX(0, "msctls_progress32", "", _
  134.               WS_VISIBLE Or WS_CHILD Or ProgressStyle Or SmoothVal, 0, 0, 0, 0, _
  135.               NoObjectParent, 0&, App.hInstance, 0&)
  136. Call SetParent(ProgBarHwnd, NoObjectParent)
  137. Else
  138. If Parent Is Nothing Then
  139.    Create = False
  140. Exit Function
  141. End If
  142.     
  143. If IsMissing(Left) Then Left = 0
  144. If IsMissing(Top) Then Top = 0
  145. If IsMissing(Width) Then Width = Parent.Width \ Screen.TwipsPerPixelX
  146. If IsMissing(Height) Then Height = 20
  147.  
  148. 'Else it's an object, then we get for object.hwnd
  149. ProgBarWnd = CreateWindowEX(0, "msctls_progress32", "", _
  150.              WS_VISIBLE Or WS_CHILD Or ProgressStyle Or SmoothVal, 0, 0, 0, 0, _
  151.              Parent.hwnd, 0&, App.hInstance, 0&)
  152.              Call SetParent(ProgBarHwnd, Parent.hwnd)
  153.  End If
  154.     
  155.     Call MoveWindow(ProgBarWnd, CLng(Left), CLng(Top), CLng(Width), CLng(Height), True)
  156.      
  157.     Call ShowWindow(ProgBarWnd, SW_SHOWNORMAL)
  158.        
  159.     
  160.     Create = (ProgBarWnd <> 0)
  161.    
  162. End Function
  163. Public Property Get Parent() As Object
  164. Set Parent = TempParent
  165. End Property
  166.  
  167. Public Property Set Parent(Frm As Object)
  168. Set TempParent = Frm
  169. End Property
  170.  
  171.  
  172. Private Sub Class_Terminate()
  173.  Exit Sub
  174.     If ProgBarWnd <> 0 Then
  175.         Call DestroyWindow(ProgBarWnd)
  176.     End If
  177. End Sub
  178.  
  179. Public Sub DestroyProgBar()
  180. On Error Resume Next
  181. If ProgBarWnd <> 0 Then
  182.    Call DestroyWindow(ProgBarWnd)
  183. End If
  184. End Sub
  185.  
  186. Public Sub ClearProgBar()
  187. On Error Resume Next
  188. 'Set Position to Zero
  189. Call SendMessage(ProgBarWnd, PBM_SETPOS, 0, 0)
  190. End Sub
  191.  
  192. Public Sub SetProgBarPos(ProgPos As Integer)
  193. DoEvents
  194. Call SendMessage(ProgBarWnd, PBM_SETPOS, ProgPos, 0)
  195. DoEvents
  196. End Sub
  197.  
  198. Public Sub DelayProgBar(itime As Integer)
  199. DoEvents
  200. Call Sleep(itime)
  201. DoEvents
  202. End Sub
  203.  
  204. Public Property Get SethWndParent() As Long
  205. SethWndParent = NoObjectParent
  206. End Property
  207. Public Property Get ProgBarHwnd() As Long
  208. ProgBarHwnd = ProgBarWnd
  209. End Property
  210. Public Property Let SethWndParent(ByVal vNewValue As Long)
  211. NoObjectParent = vNewValue
  212. End Property
  213.  
  214.  
  215.